home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / graphics / tabplot.arc / TAB_PLOT.LST < prev    next >
File List  |  1988-05-01  |  13KB  |  659 lines
  1. ' ===========================================================
  2. ' TAB_PLOT version 0.2 April 1988
  3. ' written by Robert Best, Aragon 1, 3831ET Leusden, Nederland
  4. ' ===========================================================
  5. Dim Q$(75)   ! menu
  6. For I%=0 To 75
  7.   Read Q$(I%)
  8.   Exit If Q$(I%)="***"
  9. Next I%
  10. Q$(I%)=""
  11. Data Desk,  TAB_PLOT 0.2,-------------------,-,-,-,-,-,-,""
  12. Data Plot, Line 1, Dots 1, Line 2, Dots 2, Invers,--------, Save, Print,""
  13. Data Scale, Xleft, Xright, Xdiv,  Xlog,---------, Ydown 1, Ytop  1, Ydiv  1
  14. Data   Ylog 1,---------, Ydown 2, Ytop  2, Ydiv  2,  Ylog 2,""
  15. Data Text, at X-axis, at Y-axis 1 , at Y-axis 2, below plot
  16. Data  movable 1, movable 2,""
  17. Data Table, Show, XYY-columns , Nr of rows, Next, Quit,"",***
  18. Menu Q$()
  19. Openw 0
  20. Wh%=Peek(&HFF8241) Mod 2   ! 1=white 0=black background
  21. 1:
  22. On Error Gosub Wrong
  23. Cls
  24. Deftext ,0,0,13
  25. Print At(34,2);"Number table"
  26. Fileselect "\*.*","",F$
  27. If F$=""
  28.   End
  29. Endif
  30. If F$="\"
  31.   Goto 1
  32. Endif
  33. Cls
  34. Print At(30,10);"Loading table "+F$
  35. Open "I",#1,F$
  36. T$=Space$(Lof(#1))
  37. Close #1
  38. Bload F$,Varptr(T$)
  39. Cls
  40. P%=Instr(T$,"===")   ! table header
  41. Gosub Digit
  42. Q%=Instr(P%,T$,Chr$(13))
  43. C%=0
  44. Repeat   ! find number of columns C%
  45.   P%=Instr(P%,T$," ")
  46.   Inc C%
  47.   Gosub Digit
  48. Until P%>Q%
  49. P%=Instr(T$,"===")
  50. Gosub Digit
  51. R%=0
  52. Repeat   ! find number of rows R%
  53.   P%=Instr(P%,T$,Chr$(13))
  54.   Inc R%
  55.   Gosub Digit
  56. Until A%=0   ! end of T$
  57. R1%=R%   ! see Nr of rows
  58. X%=1
  59. Y1%=2
  60. If C%=2 Or C%=3
  61.   Y2%=-C%*(C%=3)
  62. Else
  63.   Gosub Column
  64. Endif
  65. Gosub Analyse
  66. Gosub Plot
  67. On Menu  Gosub Select
  68. Do
  69.   On Menu
  70. Loop
  71. ' ================= main procedures =============
  72. Procedure Column
  73.   A:
  74.   Gosub Input1("Select column 1-"+Str$(C%)+" for X",*X%)
  75.   Gosub Input1("Select column 1-"+Str$(C%)+" for Y",*Y1%)
  76.   M$=Chr$(10)+Chr$(10)+Chr$(13)+Space$(16)+"or type 0 if you don't want a second Y"
  77.   Gosub Input1("Select column 1-"+Str$(C%)+" for second Y"+M$,*Y2%)
  78.   If X%<1 Or X%>C% Or Y1%<1 Or Y1%>C% Or Y2%<0 Or Y2%>C%
  79.     Goto A
  80.   Endif
  81. Return
  82. Procedure Analyse
  83.   Cls
  84.   Erase X()
  85.   Erase Y1()
  86.   Dim X(R%),Y1(R%)
  87.   Gosub Fill(*X(),X%,"X")
  88.   Gosub Range(*X())   ! for automatic scaling
  89.   Xmi=Mi
  90.   Xo=Mi   ! Xo can be changed, Xmi not
  91.   Xe=Ma
  92.   Gosub Fill(*Y1(),Y1%,"Y 1")
  93.   Gosub Range(*Y1())
  94.   Y1mi=Mi
  95.   Y1o=Mi
  96.   Y1e=Ma
  97.   If Y2%
  98.     Erase Y2()
  99.     Dim Y2(R%)
  100.     Gosub Fill(*Y2(),Y2%,"Y 2")
  101.     Gosub Range(*Y2())
  102.     Y2mi=Mi
  103.     Y2o=Mi
  104.     Y2e=Ma
  105.     Dot2%=1
  106.     Y2div%=5
  107.   Endif
  108.   Dot1%=1
  109.   Xdiv%=8
  110.   Y1div%=5
  111.   Clr X$,Y1$,Y2$,B$,Xlog%,Y1log%,Y2log%
  112.   Erase M$()
  113.   Erase H%()
  114.   Erase V%()
  115.   Dim M$(2),H%(2),V%(2)
  116.   Gosub Menu
  117. Return
  118. Procedure Plot
  119.   Cls
  120.   Box 64,8,576,328
  121.   Deftext ,,900,6
  122.   Text 10,250,Y1$
  123.   Deftext ,,0,6
  124.   Text 200,360,X$
  125.   Text 10,378,B$
  126.   Text H%(1),V%(1),M$(1)   ! see Proc. Move
  127.   Text H%(2),V%(2),M$(2)
  128.   Defnum 3
  129.   On 1+Xlog% Gosub Xlinscale,Xlogscale
  130.   On 1+Y1log% Gosub Y1linscale,Y1logscale
  131.   If Dot1%   ! draw dots
  132.     Deftext ,,,4
  133.     For I%=1 To R%
  134.       Gosub Screencoord(X(I%),Y1(I%),Y1log%,Y1o,Y1e,Sy1)
  135.       If H%*V%
  136.         Text H%-2,V%+2,"O"
  137.       Endif
  138.     Next I%
  139.   Else   ! draw line
  140.     Gosub Screencoord(X(1),Y1(1),Y1log%,Y1o,Y1e,Sy1)
  141.     J%=H%
  142.     K%=V%
  143.     For I%=2 To R%
  144.       Gosub Screencoord(X(I%),Y1(I%),Y1log%,Y1o,Y1e,Sy1)
  145.       If J%*K%*H%*V%
  146.         Line J%,K%,H%,V%
  147.       Endif
  148.       J%=H%
  149.       K%=V%
  150.     Next I%
  151.   Endif
  152.   If Y2%
  153.     Deftext ,,900,6
  154.     Text 637,250,Y2$
  155.     Deftext ,,0,6
  156.     On 1+Y2log% Gosub Y2linscale,Y2logscale
  157.     If Dot2%
  158.       Deftext ,,,4
  159.       For I%=1 To R%
  160.         Gosub Screencoord(X(I%),Y2(I%),Y2log%,Y2o,Y2e,Sy2)
  161.         If H%*V%
  162.           Text H%-2,V%+2,"O"
  163.         Endif
  164.       Next I%
  165.     Else
  166.       Gosub Screencoord(X(1),Y2(1),Y2log%,Y2o,Y2e,Sy2)
  167.       J%=H%
  168.       K%=V%
  169.       For I%=2 To R%
  170.         Gosub Screencoord(X(I%),Y2(I%),Y2log%,Y2o,Y2e,Sy2)
  171.         If J%*K%*H%*V%
  172.           Line J%,K%,H%,V%
  173.         Endif
  174.         J%=H%
  175.         K%=V%
  176.       Next I%
  177.     Endif
  178.   Endif
  179.   Deftext ,,,13
  180. Return
  181. Procedure Select
  182.   Menu Off
  183.   A$=Q$(Menu(0))
  184.   If A$="  TAB_PLOT 0.2"
  185.     Alert 0,"Plot program|for scientists",1,"Return",I%
  186.   Endif
  187.   If A$=" Line 1"
  188.     Dot1%=0
  189.   Endif
  190.   If A$=" Dots 1"
  191.     Dot1%=1
  192.   Endif
  193.   If A$=" Line 2"
  194.     Dot2%=0
  195.   Endif
  196.   If A$=" Dots 2"
  197.     Dot2%=1
  198.   Endif
  199.   If A$=" Invers"
  200.     W%=Peek(&HFF8241) Mod 2
  201.     Setcolor 0,1-W%
  202.   Endif
  203.   If A$=" Save"
  204.     Gosub Save(1)
  205.   Endif
  206.   If A$=" Print"
  207.     Gosub Save(0)
  208.   Endif
  209.   If A$=" Xleft"
  210.     S1:
  211.     Print At(11,20);"Xleft ="'Xo,
  212.     Gosub Input2(Xo,*Xo)
  213.     If Xo>=Xe Or (Xlog% And Xo<=0)
  214.       Goto S1
  215.     Endif
  216.     Menu 24,2+(Xmi>0)*(Xo>0)
  217.   Endif
  218.   If A$=" Xright"
  219.     S2:
  220.     Print At(11,20);"Xright  ="'Xe,
  221.     Gosub Input2(Xe,*Xe)
  222.     If Xe<=Xo
  223.       Goto S2
  224.     Endif
  225.   Endif
  226.   If A$=" Xdiv"
  227.     S3:
  228.     Print At(11,20);"Xdiv ="'Xdiv%,
  229.     Gosub Input2(Xdiv%,*Xdiv%)
  230.     If Xdiv%<1
  231.       Goto S3
  232.     Endif
  233.   Endif
  234.   If A$="  Xlog"
  235.     Xlog%=1-Xlog%
  236.     Menu 24,Xlog%
  237.     Menu 23,3-Xlog%
  238.   Endif
  239.   If A$=" Ydown 1"
  240.     S4:
  241.     Print At(11,20);"Ydown 1 ="'Y1o,
  242.     Gosub Input2(Y1o,*Y1o)
  243.     If Y1o>=Y1e Or (Y1log% And Y1o<=0)
  244.       Goto S4
  245.     Endif
  246.     Menu 29,2+(Y1mi>0)*(Y1o>0)
  247.   Endif
  248.   If A$=" Ytop  1"
  249.     S5:
  250.     Print At(11,20);"Ytop 1 ="'Y1e,
  251.     Gosub Input2(Y1e,*Y1e)
  252.     If Y1e<=Y1o
  253.       Goto S5
  254.     Endif
  255.   Endif
  256.   If A$=" Ydiv  1"
  257.     S6:
  258.     Print At(11,20);"Ydiv 1 ="'Y1div%,
  259.     Gosub Input2(Y1div%,*Y1div%)
  260.     If Y1div%<1
  261.       Goto S6
  262.     Endif
  263.   Endif
  264.   If A$="  Ylog 1"
  265.     Y1log%=1-Y1log%
  266.     Menu 29,Y1log%
  267.     Menu 28,3-Y1log%
  268.   Endif
  269.   If A$=" Ydown 2"
  270.     S7:
  271.     Print At(11,20);"Ydown 2 ="'Y2o,
  272.     Gosub Input2(Y2o,*Y2o)
  273.     If Y2o>=Y2e Or (Y2log% And Y2o<=0)
  274.       Goto S7
  275.     Endif
  276.     Menu 34,2+(Y2mi>0)*(Y2o>0)
  277.   Endif
  278.   If A$=" Ytop  2"
  279.     S8:
  280.     Print At(11,20);"Ytop 2 ="'Y2e,
  281.     Gosub Input2(Y2e,*Y2e)
  282.     If Y2e<=Y2o
  283.       Goto S8
  284.     Endif
  285.   Endif
  286.   If A$=" Ydiv  2"
  287.     S9:
  288.     Print At(11,20);"Ydiv 2 ="'Y2div%,
  289.     Gosub Input2(Y2div%,*Y2div%)
  290.     If Y2div%<1
  291.       Goto S9
  292.     Endif
  293.   Endif
  294.   If A$="  Ylog 2"
  295.     Y2log%=1-Y2log%
  296.     Menu 34,Y2log%
  297.     Menu 33,3-Y2log%
  298.   Endif
  299.   If A$=" at X-axis"
  300.     Print At(11,20);
  301.     Line Input "Text at X-axis: ",X$
  302.   Endif
  303.   If A$=" at Y-axis 1 "
  304.     Print At(11,20);
  305.     Line Input "Text at Y1-axis: ",Y1$
  306.   Endif
  307.   If A$=" at Y-axis 2"
  308.     Print At(11,20);
  309.     Line Input "Text at Y2-axis: ",Y2$
  310.   Endif
  311.   If A$=" below plot"
  312.     Print At(11,19);
  313.     Line Input "Text below plot: ",B$
  314.   Endif
  315.   If A$=" movable 1"
  316.     Gosub Move(1)
  317.   Endif
  318.   If A$=" movable 2"
  319.     Gosub Move(2)
  320.   Endif
  321.   If A$=" Show"
  322.     Gosub Show
  323.   Endif
  324.   If A$=" XYY-columns "
  325.     Gosub Column
  326.     Gosub Analyse
  327.   Endif
  328.   If A$=" Nr of rows"
  329.     S10:
  330.     Gosub Input1("Type number of rows",*R%)
  331.     If R%<2 Or R%>R1%
  332.       Goto S10
  333.     Endif
  334.     Gosub Analyse
  335.   Endif
  336.   If A$=" Next"
  337.     Run
  338.   Endif
  339.   If A$=" Quit"
  340.     Setcolor 0,Wh%
  341.     End
  342.   Endif
  343.   Gosub Plot
  344. Return
  345. ' ================= other procedures ==============
  346. Procedure Wrong
  347.   If Err=10
  348.     Alert 0,"Sorry, file too long,|more than 32 kB",1,"Return",I%
  349.     Close #1
  350.   Else
  351.     Alert 0,"Error "+Str$(Err),1,"Return",I%
  352.   Endif
  353.   Resume 1
  354. Return
  355. Procedure Menu
  356.   Menu 24,2+(Xo>0)*(Xmi>0)   ! Xlog inactive if Xo<=0 or Xmi<=0
  357.   Menu 24,Xlog%   ! checkmark
  358.   Menu 23,3-Xlog%   ! Xdiv inactive if Xlog
  359.   Menu 29,2+(Y1o>0)*(Y1mi>0)
  360.   Menu 29,Y1log%
  361.   Menu 28,3-Y1log%
  362.   If Y2%
  363.     Menu 34,2+(Y2o>0)*(Y2mi>0)
  364.     Menu 34,Y2log%
  365.     Menu 33,3-Y2log%
  366.   Else   ! deactivate
  367.     Menu 13,2
  368.     Menu 14,2
  369.     For I%=31 To 34
  370.       Menu I%,2
  371.     Next I%
  372.     Menu 39,2
  373.   Endif
  374. Return
  375. Procedure Digit
  376.   Repeat   ! find next digit
  377.     A%=Asc(Mid$(T$,P%,1))
  378.     Exit If A%>47 And A%<58
  379.     Inc P%
  380.   Until A%=0   ! end of T$
  381. Return
  382. Procedure Number
  383.   Repeat   ! find next digit or dot or minus
  384.     A%=Asc(Mid$(T$,P%,1))
  385.     Exit If A%>44 And A%<58 And A%<>47
  386.     Inc P%
  387.   Until A%=0
  388.   L%=Instr(P%,T$," ")-P